perm filename PACKER.FOR[P11,LCS] blob sn#414652 filedate 1979-01-30 generic text, type T, neo UTF8
	DIMENSION I(80)
	DATA IBLA/' '/
1	FORMAT(80A1)
2	FORMAT(' TYPE'/)
3	FORMAT(1XA4)
4	TYPE 2
	ACCEPT 1,I
	N=1
	DO 6 J=80,1,-1
6	IF(I(J).NE.IBLA)GO TO 7
7	DO 5 K=1,J+1
	IF(I(K).NE.IBLA)GO TO 5
	CALL PACKER(X,I(N))
	TYPE 3,X
	N=K+1
5	CONTINUE
	GO TO 4
	END

	SUBROUTINE PACKER(NAM,INP)
	DATA IBLA/' '/,ISEMI/';'/,IARO/"575004020100/,IEQU/'='/
C****** THE BIG NUMBER=LEFT ARROW
C11	DOUBLE PRECISION NAM
	DIMENSION INP(1),KNM(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	1 , MM/"774000000000/

	NAM=0  
	DO 1 J=1,80
	N=INP(J)
	IF(N.EQ.IARO.OR.N.EQ.IEQU)GO TO 2
1	IF(N.EQ.IBLA.OR.N.EQ.ISEMI)GO TO 2
2	II=J
	J=J-1
	N=J
	IF(J.GT.4)N=4
4	DO 10 K=1,4
	IF(K.GT.N)GO TO 11
	KNM(K)=INP(K)
	GO TO 10
11	KNM(K)=IBLA
10	CONTINUE
	KNM(5)=IBLA
C ABOVE FOR PDP10 ONLY*********
C N=WDCNT 
	DO 12 K=5,1,-1
	NAM=NAM .OR. (KNM(K) .AND. MM)
	IF (K.EQ.1)RETURN
17	IF (NAM.GE.0)GO TO 13
	NAM = (( NAM .AND. LL)/KK) .OR. JJ
	GO TO 12
13	NAM = NAM / KK
12	CONTINUE

	END